home *** CD-ROM | disk | FTP | other *** search
/ Atari Mega Archive 1 / Atari Mega Archive - Volume 1.iso / gnu / emacs / emacs1857 / bin_d2.zoo / lisp / backquote.el < prev    next >
Lisp/Scheme  |  1991-12-02  |  12KB  |  323 lines
  1. ;; Copyright (C) 1985 Free Software Foundation, Inc.
  2. ;; Written by Dick King (king@kestrel).
  3.  
  4. ;; This file is part of GNU Emacs.
  5.  
  6. ;; GNU Emacs is free software; you can redistribute it and/or modify
  7. ;; it under the terms of the GNU General Public License as published by
  8. ;; the Free Software Foundation; either version 1, or (at your option)
  9. ;; any later version.
  10.  
  11. ;; GNU Emacs is distributed in the hope that it will be useful,
  12. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  13. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14. ;; GNU General Public License for more details.
  15.  
  16. ;; You should have received a copy of the GNU General Public License
  17. ;; along with GNU Emacs; see the file COPYING.  If not, write to
  18. ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  19.  
  20.  
  21. ;;; This is a rudimentry backquote package written by D. King,
  22.  ;;; king@kestrel, on 8/31/85.  (` x) is a macro
  23.  ;;; that expands to a form that produces x.  (` (a b ..)) is
  24.  ;;; a macro that expands into a form that produces a list of what a b
  25.  ;;; etc. would have produced.  Any element can be of the form
  26.  ;;; (, <form>) in which case the resulting form evaluates
  27.  ;;; <form> before putting it into place, or (,@ <form>), in which
  28.  ;;; case the evaluation of <form> is arranged for and each element
  29.  ;;; of the result (which must be a (possibly null) list) is inserted.
  30. ;;; As an example, the immediately following macro push (v l) could
  31.  ;;; have been written 
  32. ;;;    (defmacro push (v l)
  33. ;;;         (` (setq (, l) (cons (,@ (list v l))))))
  34.  ;;; although
  35. ;;;    (defmacro push (v l)
  36. ;;;         (` (setq (, l) (cons (, v) (, l)))))
  37.  ;;; is far more natural.  The magic atoms ,
  38.  ;;; and ,@ are user-settable and list-valued.  We recommend that
  39.  ;;; things never be removed from this list lest you break something
  40.  ;;; someone else wrote in the dim past that comes to be recompiled in
  41.  ;;; the distant future.
  42.  
  43. ;;; LIMITATIONS: tail consing is not handled correctly.  Do not say
  44.  ;;; (` (a . (, b))) - say (` (a (,@ b)))
  45.  ;;; which works even if b is not list-valued.
  46. ;;; No attempt is made to handle vectors.  (` [a (, b) c]) doesn't work.
  47. ;;; Sorry, you must say things like
  48.  ;;; (` (a (,@ 'b))) to get (a . b) and 
  49.  ;;; (` ((, ',) c)) to get (, c) - [(` (a , b)) will work but is a bad habit]
  50. ;;; I haven't taught it the joys of nconc.
  51. ;;; (` atom) dies.  (` (, atom)) or anything else is okay.
  52.  
  53. ;;; BEWARE BEWARE BEWARE
  54.  ;;; inclusion of (,atom) rather than (, atom) or (,@atom) rather than
  55.  ;;; (,@ atom) will result in errors that will show up very late.
  56.  ;;; This is so crunchy that I am considering including a check for
  57.  ;;; this or changing the syntax to ... ,(<form>).  RMS: opinion?
  58.  
  59.  
  60. (provide 'backquote)
  61.  
  62. ;;; a raft of general-purpose macros follows.  See the nearest
  63.  ;;; Commonlisp manual.
  64. (defmacro bq-push (v l)
  65.   "Pushes evaluated first form onto second unevaluated object
  66. a list-value atom"
  67.   (list 'setq l (list 'cons v l)))
  68.  
  69. (defmacro bq-caar (l)
  70.   (list 'car (list 'car l)))
  71.  
  72. (defmacro bq-cadr (l)
  73.   (list 'car (list 'cdr l)))
  74.  
  75. (defmacro bq-cdar (l)
  76.   (list 'cdr (list 'car l)))
  77.  
  78.  
  79. ;;; These two advertised variables control what characters are used to
  80.  ;;; unquote things.  I have included , and ,@ as the unquote and
  81.  ;;; splice operators, respectively, to give users of MIT CADR machine
  82.  ;;; derivitive machines a warm, cosy feeling.
  83.  
  84. (defconst backquote-unquote '(,)
  85.   "*A list of all objects that stimulate unquoting in `.  Memq test.")
  86.  
  87.  
  88. (defconst backquote-splice '(,@)
  89.   "*A list of all objects that stimulate splicing in `.  Memq test.")
  90.  
  91.  
  92. ;;; This is the interface 
  93. (defmacro ` (form)
  94.   "(` FORM) Expands to a form that will generate FORM.
  95. FORM is `almost quoted' -- see backquote.el for a description."
  96.   (bq-make-maker form))
  97.  
  98. ;;; We develop the method for building the desired list from
  99.  ;;; the end towards the beginning.  The contract is that there be a
  100.  ;;; variable called state and a list called tailmaker, and that the form
  101.  ;;; (cons state tailmaker) deliver the goods.  Exception - if the
  102.  ;;; state is quote the tailmaker is the form itself.
  103. ;;; This function takes a form and returns what I will call a maker in
  104.  ;;; what follows.  Evaluating the maker would produce the form,
  105.  ;;; properly evaluated according to , and ,@ rules.
  106. ;;; I work backwards - it seemed a lot easier.  The reason for this is
  107.  ;;; if I'm in some sort of a routine building a maker and I switch
  108.  ;;; gears, it seemed to me easier to jump into some other state and
  109.  ;;; glue what I've already done to the end, than to to prepare that
  110.  ;;; something and go back to put things together.
  111. (defun bq-make-maker (form)
  112.   "Given one argument, a `mostly quoted' object, produces a maker.
  113. See backquote.el for details"
  114.   (let ((tailmaker (quote nil)) (qc 0) (ec 0) (state nil))
  115.     (mapcar 'bq-iterative-list-builder (reverse form))
  116.     (and state
  117.      (cond ((eq state 'quote)
  118.         (list state tailmaker))
  119.            ((= (length tailmaker) 1)
  120.         (funcall (bq-cadr (assq state bq-singles)) tailmaker))
  121.            (t (cons state tailmaker))))))
  122.  
  123. ;;; There are exceptions - we wouldn't want to call append of one
  124.  ;;; argument, for example.
  125. (defconst bq-singles '((quote bq-quotecar)
  126.                (append car)
  127.                (list bq-make-list)
  128.                (cons bq-id)))
  129.  
  130. (defun bq-id (x) x)
  131.  
  132. (defun bq-quotecar (x) (list 'quote (car x)))
  133.  
  134. (defun bq-make-list (x) (cons 'list x))
  135.  
  136. ;;; fr debugging use only
  137. ;(defun funcalll (a b) (funcall a b))
  138. ;(defun funcalll (a b) (debug nil 'enter state tailmaker a b)
  139. ;  (let ((ans (funcall a b))) (debug  nil 'leave state tailmaker)
  140. ;       ans))
  141.  
  142. ;;; Given a state/tailmaker pair that already knows how to make a
  143.  ;;; partial tail of the desired form, this function knows how to add
  144.  ;;; yet another element to the burgening list.  There are four cases;
  145.  ;;; the next item is an atom (which will certainly be quoted); a 
  146.  ;;; (, xxx), which will be evaluated and put into the list at the top
  147.  ;;; level; a (,@ xxx), which will be evaluated and spliced in, or
  148.  ;;; some other list, in which case we first compute the form's maker,
  149.  ;;; and then we either launch into the quoted case if the maker's
  150.  ;;; top level function is quote, or into the comma case if it isn't.
  151. ;;; The fourth case reduces to one of the other three, so here we have
  152.  ;;; a choice of three ways to build tailmaker, and cit turns out we
  153.  ;;; use five possible values of state (although someday I'll add
  154.  ;;; nconcto the possible values of state).
  155. ;;; This maintains the invariant that (cons state tailmaker) is the
  156.  ;;; maker for the elements of the tail we've eaten so far.
  157. (defun bq-iterative-list-builder (form)
  158.   "Called by bq-make-maker.  Adds a new item form to tailmaker, 
  159. changing state if need be, so tailmaker and state constitute a recipie
  160. for making the list so far."
  161.   (cond ((atom form)
  162.      (funcall (bq-cadr (assq state bq-quotefns)) form))
  163.     ((memq (car form) backquote-unquote)
  164.      (funcall (bq-cadr (assq state bq-evalfns)) (bq-cadr form)))
  165.     ((memq (car form) backquote-splice)
  166.      (funcall (bq-cadr (assq state bq-splicefns)) (bq-cadr form)))
  167.     (t
  168.      (let ((newform (bq-make-maker form)))
  169.        (if (and (listp newform) (eq (car newform) 'quote))
  170.            (funcall (bq-cadr (assq state bq-quotefns)) (bq-cadr newform))
  171.          (funcall (bq-cadr (assq state bq-evalfns)) newform))))
  172.     ))
  173.  
  174. ;;; We do a 2-d branch on the form of splicing and the old state.
  175.  ;;; Here's fifteen functions' names...
  176. (defconst bq-splicefns '((nil bq-splicenil)
  177.              (append bq-spliceappend)
  178.              (list bq-splicelist)
  179.              (quote bq-splicequote)
  180.              (cons bq-splicecons)))
  181.  
  182. (defconst bq-evalfns '((nil bq-evalnil)
  183.                (append bq-evalappend)
  184.                (list bq-evallist)
  185.                (quote bq-evalquote)
  186.                (cons bq-evalcons)))
  187.  
  188. (defconst bq-quotefns '((nil bq-quotenil)
  189.             (append bq-quoteappend)
  190.             (list bq-quotelist)
  191.             (quote bq-quotequote)
  192.             (cons bq-quotecons)))
  193.  
  194. ;;; The name of each function is
  195.  ;;; (concat 'bq- <type-of-element-addition> <old-state>)
  196. ;;; I'll comment the non-obvious ones before the definitions...
  197.  ;;; In what follows, uppercase letters and form will always be
  198.  ;;; metavariables that don't need commas in backquotes, and I will
  199.  ;;; assume the existence of somethi